perm filename PPRINT.MLI[MLI,LSP] blob sn#139512 filedate 1975-06-03 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00004 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	BEGIN
C00006 00003	SPECIAL ?&X?&, ?&Y?&
C00010 00004	% AUXILIARY FUNCTIONS %
C00012 ENDMK
C⊗;
BEGIN


%

This program contains a set of functions for printing LISP s-expressions
in an easily readable format,  called "pretty-printing".  These functions
are used by the MLISP translator when the LISP translation of an MLISP
program is printed.  The principal functions are PPRINTQ, PPRINT, DPRINT
and SPRINT:


PPRINTQ(L) --- an FEXPR; takes any number of arguments, which are not evaluated.
	It just calls PPRINT(L, NIL).  This relieves the user of having to
	quote functions to be PPRINT'ed.


PPRINT(L, EXPAND) --- an EXPR;  takes two arguments:
	(1) L      - a list, each of whose elements should be either:
			(a) an atom, in which case its property list is checked
			    for any of several indicators, and  each property
	                    found is DPRINT'ed out, or
			(b) a new list of indicators to check for.
	(2) EXPAND - T or NIL.
		     T   => expand macros before printing;
		     NIL => don't expand macros.


DPRINT(SEXP, EXPAND) --- an EXPR; takes two arguments:
	(1) SEXP   - an s-expression to be "pretty printed";  DPRINT is the
		     same as SPRINT except it has a special format for DEFPROPs.
	(2) EXPAND - T or NIL.
		     T   => expand macros before printing;
		     NIL => don't expand macros.


SPRINT(SEXP, COLUMN, EXPAND) --- an EXPR;  takes three arguments:
	(1) SEXP   - an s-expression to be "pretty printed";  SPRINT does
		     all the work of pretty printing.
	(2) COLUMN - the column (counting from 1) in which to begin printing.
	(3) EXPAND - T or NIL.
		     T   => expand macros before printing;
		     NIL => don't expand macros.
	SPRINT is very low-level; it starts printing at the current character
	position and does no TERPRIs after the last character printed
	(i.e. it prints only the characters given it and nothing else).



Primitive functions needed are:

LINELENGTH(NIL) = the number of characters on a print line.

CHRCT()		= the number of characters remaining on the current line
		  without exceeding LINELENGTH.

FLATSIZE(SEXP)	= the number of characters (including spaces) in the
		  s-expression SEXP.

%
SPECIAL ?&X?&, ?&Y?&;


FEXPR PPRINTQ (L);				% QUOTES ITS ARGUMENTS %
	PPRINT(L, NIL);


EXPR PPRINT (L, EXPAND);			% PRETTY PRINT A LIST OF ATOMS %
	BEGIN  NEW INDS;
	INDS ←'(VALUE SPECIAL MACRO EXPR FEXPR);% INDICATORS INITIALLY CHECKED FOR %
	FOR NEW A IN L DO
	IF ATOM A THEN				% ATOM ? %
		FOR NEW IND IN INDS DO		% YES, CHECK FOR PROPERTIES %
		IF GET(A, IND) THEN
			DPRINT(<'DEFPROP, A, GET(A, IND), IND>, EXPAND)
		ELSE NIL
	ELSE INDS ← A;				% NOT ATOM => NEW LIST OF INDICATORS %
	END;

	
EXPR DPRINT (SEXPR, EXPAND);				% SAME AS SPRINT, EXCEPT  %
	IF ¬ATOM SEXPR AND CAR(SEXPR) EQ 'DEFPROP THEN	% IT HAS A SPECIAL FORMAT %
		BEGIN					% FOR DEFPROPS		  %
		PRINC TERPRI "(DEFPROP ";
		PRIN1 SEXPR[2];
		TERPRI SPRINT(TERPRI SEXPR[3], 2, EXPAND);
		PRIN1 SEXPR[4];
		TERPRI PRINC ")";
		END
	ELSE TERPRI SPRINT(TERPRI SEXPR, 1, EXPAND);


EXPR SPRINT (SEXP, COLUMN, EXPAND);		% S-EXPRESSION PRINT %
	?&SPRINT1(IF EXPAND THEN EXPAND_MACROS(SEXP) ELSE SEXP, COLUMN, 0);


EXPR ?&SPRINT1 (SEXP, COLUMN, RIGHT_END);	% THIS DOES MOST OF THE WORK %
	BEGIN
	IF ?&COL() GREATERP COLUMN THEN		% PAST THE DESIRED COLUMN %
		TERPRI NIL;
	FOR NEW ?&X?& ← ?&COL()+1 TO COLUMN DO	% SKIP TO DESIRED COLUMN %
		PRINC " ";
	IF ATOM SEXP OR FLATSIZE(SEXP) + RIGHT_END LESSP CHRCT() THEN
		RETURN PRIN1 SEXP;
	PRINC "(";
	IF ATOM CAR(SEXP) AND (LENGTH(SEXP) ≥ 3 OR FLATSIZE(CAR SEXP) = 1)
	    AND ?&SIZE(SEXP) LESSP CHRCT() THEN
		BEGIN  NEW PR;			% PRINT ELEMENTS IN FUNCTION FORM %
		IF PR ← PRIN1(CAR SEXP) EQ 'PROG THEN
			SPRINT(CAR(SEXP ← CDR SEXP), COLUMN ← ?&COL()+1, NIL)
		ELSE IF CAR SEXP EQ 'LAMBDA THEN COLUMN ← ?&COL()-6
			ALSO SPRINT(CAR(SEXP ← CDR SEXP), ?&COL()+1, NIL)
		ELSE COLUMN ← ?&COL()+1;
		DO NIL UNTIL
			IF ?&DOT(CDR SEXP,
				IF PR AND ATOM SEXP[2] THEN COLUMN-5 ELSE COLUMN,
				RIGHT_END) THEN
					PRIN1(CDDR SEXP)
			ELSE IF CDR(SEXP ← CDR SEXP) THEN
				COLUMN LESSP ?&COL() AND TERPRI NIL
			ELSE T;
		END
	ELSE COLUMN ← ?&COL()			% PRINT ELEMENTS IN A COLUMN %
		ALSO DO NIL UNTIL
			IF ?&DOT(SEXP, COLUMN, RIGHT_END) THEN PRIN1(CDR SEXP)
			ELSE IF SEXP ← CDR SEXP THEN TERPRI NIL
			ELSE T;
	PRINC ")";
	END;
% AUXILIARY FUNCTIONS %


EXPR ?&DOT (SEXP, COLUMN, RIGHT_END);		% CHECK IF 'SEXP' IS A DOTTED PAIR %
	PROG2(	?&SPRINT1(CAR SEXP, COLUMN,
			IF NULL(SEXP ← CDR SEXP) THEN RIGHT_END + 1
			ELSE IF ATOM SEXP THEN RIGHT_END + 4 + FLATSIZE(SEXP)
			ELSE 0),
		IF SEXP AND ATOM SEXP THEN	% VALUE IS TRUE IFF A DOTTED PAIR %
			PRINC " . "
		ELSE NIL);


EXPR ?&SIZE (SEXP);				% ANALYZE SIZE, COMPLEXITY OF SEXP %
	IF ATOM SEXP OR ATOM CDR(SEXP) THEN	% THE 15 IS ARBITRARY %
		FLATSIZE(SEXP) + 15		% IT CONTROLS HOW TIGHTLY %
	ELSE FLATSIZE(SEXP[1]) + 2 +		% INDENTATION IS BOUND TO LEFT MARGIN %
		?&SIZE(SEXP[2]);


EXPR ?&COL ();					% NEXT COLUMN TO BE PRINTED INTO %
	LINELENGTH(NIL) - CHRCT() + 1;



% MACRO-EXPANDING FUNCTIONS %


EXPR EXPAND_MACROS (SEXP);			% EXPANDS ANY MACROS IN 'SEXP' %
	IF ATOM SEXP OR CAR(SEXP) EQ 'QUOTE THEN SEXP
	ELSE IF ?&IS_MACRO(CAR SEXP) THEN
		EXPAND_MACROS(LAMBDA(M,S); M(S); (GET(CAR SEXP, 'MACRO), SEXP))
	ELSE EXPAND_MACROS(CAR SEXP) CONS ?&EXPAND_REST(CDR SEXP);


EXPR ?&EXPAND_REST (L);
	IF ATOM L THEN L ELSE EXPAND_MACROS(CAR L) CONS ?&EXPAND_REST(CDR L);


EXPR ?&IS_MACRO (A);
	ATOM A AND NOT NUMBERP(A) AND GET(A, 'MACRO);


END.